Tracks 1-48

Value Boxes

Best Track (6.383S from WR)

N64 Rainbow Road

Worst Track (12.572S from WR)

3DS Music Park

Most Recent PB (Set on 2022-09-11)

Bone-Dry Dunes

Oldest PB (Set on 2022-02-01)

GBA Ribbon Road

Graphs

PBs by Week

Weighted Average Improvement by Week

Improvement for each track weighted by percent of PBs that week compared to total.

Cumulative Improvement

Violin

PB Time Distributions, Feb 01, 2022 - Present

Tracks 49-96

Value Boxes

Best Track (6.361S from WR)

Tour Tokyo Blur

Worst Track (13.72S from WR)

Wii Mushroom Gorge

Most Recent PB (Set on 2022-08-14)

Wii Coconut Mall

Oldest PB (Set on 2022-03-18)

GBA Sky Garden

Graphs

PB Count by Week

Weighted Average Improvement by Week

Improvement for each track weighted by percent of PBs that week compared to total.

Cumulative Improvement

Violin

PB Time Distributions

Tables

Current PBs

Current PBs

Track PB Date PB WR Diff
Mushroom Mario Kart Stadium 2022-08-14 1M 45.158S 10.446
Water Park 2022-08-14 1M 48.01S 7.826
Sweet Sweet Canyon 2022-08-17 1M 55.716S 6.871
Thwomp Ruins 2022-07-23 1M 56.663S 7.688
Flower Mario Circuit 2022-08-17 1M 53.422S 8.091
Toad Harbor 2022-08-17 2M 12.859S 10.521
Twisted Mansion 2022-08-14 2M 4.604S 10.144
Shy Guy Falls 2022-08-15 2M 7.893S 11.685
Star Sunshine Airport 2022-08-15 2M 9.102S 10.999
Dolphin Shoals 2022-08-15 2M 5.647S 12.241
Electrodrome 2022-08-15 2M 7.453S 11.488
Mount Wario 2022-08-31 1M 51.45S 9.467
Special Cloudtop Cruise 2022-08-17 2M 11.339S 11.553
Bone-Dry Dunes 2022-09-11 1M 58.815S 11.903
Bowser’s Castle 2022-08-17 2M 9.397S 10.402
Rainbow Road 2022-08-17 2M 11.477S 12.163
Shell Wii Moo Moo Meadows 2022-08-17 1M 31.958S 7.498
GBA Mario Circuit 2022-09-02 1M 31.131S 7.294
DS Cheep Cheep Beach 2022-08-17 1M 56.547S 9.499
N64 Toad’s Turnpike 2022-08-17 1M 53.609S 7.236
Banana GCN Dry Dry Desert 2022-09-02 2M 5.475S 11.851
SNES Donut Plains 3 2022-08-31 1M 23.495S 10.662
N64 Royal Raceway 2022-08-17 2M 7.086S 11.432
3DS DK Jungle 2022-08-14 2M 12.646S 11.470
Leaf DS Wario Stadium 2022-08-14 2M 3.195S 12.201
GCN Sherbet Land 2022-09-02 1M 58.752S 11.754
3DS Music Park 2022-07-03 2M 3.551S 12.572
N64 Yoshi Valley 2022-08-14 2M 6.218S 7.787
Lightning DS Tick-Tock Clock 2022-08-14 1M 54.861S 12.516
3DS Piranha Plant Slide 2022-08-14 2M 9.61S 10.386
Wii Grumble Volcano 2022-08-19 2M 4.488S 11.300
N64 Rainbow Road 2022-08-14 1M 26.372S 6.383
Egg GCN Yoshi Circuit 2022-08-14 1M 54.189S 12.051
Excitebike Arena 2022-08-18 1M 50.425S 10.438
Dragon Driftway 2022-08-19 1M 50.088S 9.468
Mute City 2022-09-11 1M 59.807S 8.529
Triforce Wii Wario’s Gold Mine 2022-08-15 2M 10.678S 8.136
SNES Rainbow Road 2022-08-18 1M 34.172S 7.904
Ice Ice Outpost 2022-09-05 1M 55.067S 9.851
Hyrule Circuit 2022-08-18 1M 57.341S 9.666
Crossing GCN Baby Park 2022-08-15 1M 10.013S 7.871
GBA Cheese Land 2022-09-02 1M 54.367S 12.431
Wild Woods 2022-08-18 1M 54.225S 8.212
Animal Crossing 2022-08-17 1M 45.158S 8.456
Bell 3DS Neo Bowser City 2022-09-03 1M 54.095S 11.524
GBA Ribbon Road 2022-08-14 1M 54.584S 9.197
Super Bell Subway 2022-08-15 1M 51.517S 11.027
Big Blue 2022-08-14 1M 32.2S 8.617
Golden Dash Tour Paris Promenade 2022-08-14 1M 58.784S 8.417
3DS Toad Circuit 2022-08-14 1M 28.148S 7.731
N64 Choco Mountain 2022-08-14 2M 2.045S 9.375
Wii Coconut Mall 2022-08-14 1M 51.731S 9.964
Lucky Cat Tour Tokyo Blur 2022-08-14 1M 32.191S 6.361
DS Shroom Ridge 2022-08-14 1M 55.359S 10.367
GBA Sky Garden 2022-08-14 1M 36.277S 9.054
Tour Ninja Hideaway 2022-06-19 2M 2.145S 9.431
Turnip Tour New York Minute 2022-08-14 1M 32.608S 9.488
SNES Mario Circuit 3 2022-08-14 1M 43.171S 12.007
N64 Kalimari Desert 2022-08-14 1M 39.011S 9.507
DS Waluigi Pinball 2022-08-06 2M 30.8S 11.305
Propeller Tour Sydney Sprint 2022-08-11 2M 11.751S 10.950
GBA Snow Land 2022-08-06 1M 38.503S 11.622
Wii Mushroom Gorge 2022-08-06 1M 41.276S 13.720
Sky-High Sundae 2022-08-04 2M 7.354S 11.886

All Records

All Records

---
title: "Mario Kart Time Trial PBs"
output:
  flexdashboard::flex_dashboard:
    orientation: rows
    theme: sandstone
    navbar:
      - { title: "Speedruns", href: "sr.html", align: right}
      - { icon: "fas fa-home", href: "index.html", align: right}
    favicon: favicon.png
    source_code: embed
---

<script>
$(document).ready(function(){
    $('[data-toggle="popover"]').popover(); 
});
</script>

```{r lib}
library(tidyverse)
library(flexdashboard)
library(rvest)
library(plotly)
library(lubridate)
library(knitr)
library(kableExtra)
library(DT)
library(emojifont)
```

```{r scrapeWRs}
# Use rvest to scrape WR leaderboard
html <- read_html("http://www.mkwrs.com/mk8dx/wrs.php")

wr0 <- html %>% html_elements(".wr") %>% html_table() %>% .[[1]] %>% 
  rename_with(tolower, everything()) %>% 
  select(track, total = `time+video`, player, date) %>% 
  filter(track != "Total:") %>% 
  mutate(total = str_replace_all(total, "'", ":"),
         total = str_replace_all(total, "\"", "."))

# Labels for violin plot (player name & date). Supports ties.
wr_label <- wr0 %>%
  group_by(track) %>%
  mutate(label = paste0(player, " (", date, ")"),
         n = row_number()) %>%
  ungroup() %>%
  select(-c(player, date)) %>%
  pivot_wider(names_from = n,
              values_from = label,
              names_prefix = "lab_") %>%
  unite("label",
        starts_with("lab_"),
        sep = " &<br>",
        na.rm = TRUE) %>% 
  mutate(label = paste0("<b>", total, "<b><br>", label)) %>% 
  select(-total)

# Use to join w/ other data & compare
wr <- wr0 %>% 
  select(track, WR_total = total) %>%
  mutate(WR_total = ms(WR_total)) %>% 
  distinct()

rm(html, wr0)
```


```{r import}
abr <- read_csv("_data/abr.csv") %>%
  mutate(track = ifelse(!is.na(source), paste(source, short), short)) %>%
  select(trkNO, trk, track, cup, type) %>%
  mutate(track = fct_inorder(track),
         cup = fct_inorder(cup))

ctrk <- abr$track
ccup <- unique(abr$cup)

tt <- read_csv("_data/time-trials.csv",
               col_types = cols(total = "c")) %>%
  filter(cc == 150) %>%
  left_join(abr, by = "trk") %>%
  select(-c(cc, trk, starts_with("lap"))) %>%
  mutate(
    total = ms(total),
    yr = year(date),
    mth = month(date),
    wk = week(date) - 4,
    day = day(date),
    hour = hour(time),
    min = minute(time),
    dt = make_datetime(
      year = yr,
      month = mth,
      day = day,
      hour = hour,
      min = min
    )
  ) %>%
  select(trkNO:type, total, date, dt, yr, wk) %>%
  arrange(track, dt) %>%
  group_by(track) %>%
  mutate(
    improve = round(as.double(lag(total) - total, units = "secs"), 3),
    improve = replace_na(improve, 0),
    cumsum = cumsum(improve)
  ) %>%
  ungroup()

tt_PB <- tt %>%
  select(track, total, dt) %>%
  group_by(track) %>%
  slice_max(dt) %>%
  ungroup() %>%
  left_join(wr, by = "track") %>%
  mutate(WR_diff = round(as.double(total - WR_total, units = "secs"), 3))

tt_all <- tt %>%
  left_join(tt_PB, by = c("track", "total", "dt")) %>%
  mutate(track = factor(track, levels = ctrk))

wk_now <- as_tibble_col(1:(week(today()) - 4)) 
```

# Tracks 1-48 

```{r}
tt_48 <- tt_all %>% 
  filter(trkNO < 49) %>% 
  group_by(track) %>% 
  mutate(sd = sd(total)) %>% 
  ungroup()
```

## Value Boxes

```{r}
v_worst_48 <- slice_max(tt_48, WR_diff)
v_best_48 <- slice_min(tt_48, WR_diff)
v_new_48 <- slice_max(tt_48, dt)
v_old_48 <- slice_min(tt_48, dt)
```

### Best Track (`r v_best_48$WR_diff`S from WR)

```{r}
valueBox(value = v_best_48$track, 
         icon = "fa fa-splotch") 
```

### Worst Track (`r v_worst_48$WR_diff`S from WR)

```{r}
valueBox(value = v_worst_48$track, 
         icon = "fa fa-poo") 
```

### Most Recent PB (Set on `r v_new_48$date`)

```{r}
valueBox(value = v_new_48$track, 
         icon = "fa fa-hourglass-start") 
```

### Oldest PB (Set on `r v_old_48$date`)

```{r}
valueBox(value = v_old_48$track, 
         icon = "fa fa-hourglass-end") 
```

## Graphs

```{r}
PBs <- count(tt_48)
  
tt_48_wk <- tt_48 %>% 
  group_by(wk) %>% 
  mutate(n = n(),
         th = sum(improve * n),
         wmean = th / PBs$n) %>% 
  ungroup() %>% 
  select(wk, wmean, n) %>% 
  distinct() %>% 
  full_join(wk_now, by = c("wk" = "value")) %>% 
  mutate(across(2:3, ~ replace_na(.x, 0))) %>% 
  arrange(wk)
```

### PBs by Week

```{r}
gg_48_wk <- tt_48_wk %>% 
  ggplot() +
  geom_line(aes(x=wk, y=n), color = "#ecc371") +
  theme_minimal() +
  labs(y = "",
       x = "Week")

ggplotly(gg_48_wk)
```

### Weighted Average Improvement by Week

```{r}
gg_48_wk_wt <- tt_48_wk %>% 
  ggplot(aes(x=wk, y=wmean)) +
  geom_line(color = "#85a1ac") +
  theme_minimal() + 
  labs(x = "Week",
       y = "Improvement (secs)")

ggplotly(gg_48_wk_wt)
```

> Improvement for each track weighted by percent of PBs that week compared to total.

### Cumulative Improvement

```{r}
gg_cts_48 <- tt_48 %>% 
  filter(improve != 0) %>% 
  arrange(dt) %>% 
  mutate(cumsum = cumsum(improve)) %>% 
  ggplot(aes(x=dt, y=cumsum)) +
  geom_step(color = "#6868ac") +
  theme_minimal() +
  labs(x="", y="Improvement (secs)") +
  theme(axis.text.x = element_text(angle = 90),
        legend.position = "none")

ggplotly(gg_cts_48)
```

## Violin

### PB Time Distributions, Feb 01, 2022 - Present

```{r violin48, fig.height=10}
gg_48 <- tt_48 %>% 
  filter(track != "GCN Baby Park") %>% 
  ggplot(aes(factor(track), total)) +
  geom_violin(draw_quantiles = 0.5, 
              scale = "width",
              aes(fill = sd, color=sd),
              alpha = .7) + 
  stat_summary(fun = "mean", geom = "crossbar", size = .2, aes(color = sd)) +
  stat_summary(fun = "median", geom = "point", size = .4) +
  geom_text(aes(factor(track), WR_total), 
            label = emoji("trophy"), 
            family = 'EmojiOne',
            size = 3) +
  scale_fill_gradient(low = "darkcyan", high = "plum") +
  scale_color_gradient(low = "darkcyan", high = "plum") +
  scale_y_time() +
  scale_x_discrete() +
  labs(x = "",
       y = "") +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45,
                                   hjust = 0.98,
                                   vjust = 0.9),
        axis.text = element_text(size = 8),
        axis.ticks = element_line(size = .2),
        panel.grid = element_line(size = .2),
        panel.border = element_rect(fill = NA, size = .2),
        legend.position = "none")

ggplotly(gg_48)
```

# Tracks 49-96 

```{r}
tt_96 <- tt_all %>% 
  filter(trkNO > 48) %>% 
  group_by(track) %>% 
  mutate(sd = sd(total)) %>% 
  ungroup()
```

## Value Boxes

```{r}
v_worst_96 <- slice_max(tt_96, WR_diff)
v_best_96 <- slice_min(tt_96, WR_diff)
v_new_96 <- slice_max(tt_96, dt)
v_old_96 <- slice_min(tt_96, dt)
```

### Best Track (`r v_best_96$WR_diff`S from WR)

```{r}
valueBox(value = v_best_96$track, 
         icon = "fa fa-splotch") 
```

### Worst Track (`r v_worst_96$WR_diff`S from WR)

```{r}
valueBox(value = v_worst_96$track, 
         icon = "fa fa-poo") 
```

### Most Recent PB (Set on `r v_new_96$date`)

```{r}
valueBox(value = v_new_96$track, 
         icon = "fa fa-hourglass-start") 
```

### Oldest PB (Set on `r v_old_96$date`)

```{r}
valueBox(value = v_old_96$track, 
         icon = "fa fa-hourglass-end") 
```

## Graphs {data-width=330}

```{r}
PBs_96 <- count(tt_96)

wk_now_96 <- wk_now %>% 
  filter(value > 6)

tt_96_wk <- tt_96 %>% 
  group_by(wk) %>% 
  mutate(n = n(),
         wt = n / PBs_96$n,
         wmean = sum(improve * wt)) %>% 
  ungroup() %>% 
  select(wk, wmean, n) %>% 
  distinct() %>% 
  full_join(wk_now_96, by = c("wk" = "value")) %>% 
  mutate(across(2:3, ~ replace_na(.x, 0))) %>% 
  arrange(wk)
```

### PB Count by Week

```{r}
gg_96_wk <- tt_96_wk %>% 
  ggplot() +
  geom_line(aes(x=wk, y=n), color = "#ecc371") +
  theme_minimal() +
  labs(y = "",
       x = "")

ggplotly(gg_96_wk)
```

### Weighted Average Improvement by Week

```{r}
gg_96_wk_wt <- tt_96_wk %>% 
  ggplot(aes(x=wk, y=wmean)) +
  geom_line(color = "#85a1ac") +
  theme_minimal() + 
  labs(x = "",
       y = "Improvement")

ggplotly(gg_96_wk_wt)
```

> Improvement for each track weighted by percent of PBs that week compared to total.

### Cumulative Improvement

```{r}
gg_cts_96 <- tt_96 %>% 
  filter(improve != 0) %>% 
  arrange(dt) %>% 
  mutate(cumsum = cumsum(improve)) %>% 
  ggplot(aes(x=dt, y=cumsum)) +
  geom_step(color = "#6868ac") +
  theme_minimal() +
  labs(x="", y="Improvement (secs)") +
  theme(axis.text.x = element_text(angle = 90),
        legend.position = "none")

ggplotly(gg_cts_96)
```

## Violin

### PB Time Distributions

```{r violin96, fig.height=10}
gg_96 <- tt_96 %>% 
  group_by(track) %>% 
  mutate(sd = sd(total)) %>% 
  ungroup() %>% 
  ggplot(aes(factor(track), total)) +
  geom_violin(draw_quantiles = 0.5, 
              scale = "width",
              aes(fill = sd, color=sd),
              alpha = .7) + 
  stat_summary(fun = "mean", geom = "crossbar", size = .2, aes(color = sd)) +
  stat_summary(fun = "median", geom = "point", size = .4) + 
  geom_text(aes(factor(track), WR_total), 
            label = emoji("trophy"), 
            family = 'EmojiOne',
            size = 3) +
  scale_fill_gradient(low = "darkcyan", high = "plum") +
  scale_color_gradient(low = "darkcyan", high = "plum") +
  scale_y_time() +
  scale_x_discrete() +
  labs(x = "",
       y = "") +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45,
                                   hjust = 0.98,
                                   vjust = 0.9),
        axis.text = element_text(size = 8),
        axis.ticks = element_line(size = .2),
        panel.grid = element_line(size = .2),
        panel.border = element_rect(fill = NA, size = .2),
        legend.position = "none")

ggplotly(gg_96)
```

# Tables {data-orientation=columns}

## Current PBs {.tabset data-width=500}

```{r}
tt_tbl <- tt_all %>%
  select(trkNO, cup, track, date, total, improve, WR_total, WR_diff) %>% 
  select(-trkNO)

PB_tbl <- tt_tbl %>% 
  filter(!is.na(WR_total)) %>% 
  select(-improve)
```

### Current PBs 

```{r}
PB_tbl %>% 
  kbl(
    col.names = c(" ", "Track", "PB Date", "PB", "WR", "WR Diff"),
    align = "c",
    escape = FALSE,
    longtable = TRUE
  ) %>% 
  kable_styling(full_width = TRUE) %>%
  column_spec(column = 1,
              extra_css = 'transform: rotate(270deg);') %>%
  column_spec(3:4,
              extra_css = 'font-size: 80%;') %>%
  column_spec(
    6,
    color = "white",
    background = spec_color(
      PB_tbl$WR_diff,
      begin = 0.3,
      end = 0.7,
      alpha = 0.7,
      option = "A"
    ),
    popover = paste0("WR: ", PB_tbl$WR_total)
  ) %>%
  remove_column(5) %>%
  collapse_rows(columns = 1,
                row_group_label_position = 'stack') %>%
  row_spec(0, align = "c")
```

## All Records {.tabset}

### All Records

```{r}
tt_tbl %>%
  select(-WR_total) %>%
  mutate(total = paste(total),
         improve = ifelse(improve == 0, NA, improve)) %>%
  arrange(desc(WR_diff)) %>%
  datatable(
    rownames = FALSE,
    colnames = c("Cup", "Track", "PB Date", "PB",
                 "Improvement", "WR Diff"),
    filter = 'top',
    options = list(pageLength = 48,
                   autoWidth = TRUE,
                   columnDefs = list(
                     list(className = 'dt-center', targets = 0:3)
                   ))
  ) %>%
  formatStyle(3:6, `font-size` = '80%') 
```